-- -*-Haskell-*-

{-
 * Copyright (c) 2007 Gabor Greif
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to deal
 * in the Software without restriction, including without limitation the rights
 * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
 * of the Software, and to permit persons to whom the Software is furnished to do
 * so, subject to the following conditions:
 *
 * The above copyright notice and this permission notice shall be
 * included in all copies or substantial portions of the Software.
 *
 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
 * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
 * OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
 * NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
 * HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
 * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE
 * OR OTHER DEALINGS IN THE SOFTWARE.
 -}


-- Adapt the Unimo concept to Omega

import "LangPrelude.prg" 

{-
data Unimo r a 
  = Unit a 
  | Effect (r (Unimo r) a) 
  | ex b. Bind (Unimo r b) (b -> Unimo r a) 
-}

data Unimo :: ((* ~> *) ~> * ~> *) ~> * ~> * where
  Unit :: a -> Unimo r a
  Effect :: (r (Unimo r) a) -> Unimo r a
  Bind :: (Unimo r b) -> (b -> Unimo r a) -> Unimo r a


--instance Monad (Unimo r) where 
--  return = Unit 
--  (>==) = Bind 

unimo :: Monad (Unimo a)
unimo = Monad Unit Bind undefined

{-

type BindOp r a v = forall b. 
  r (Unimo r) b 
  -> (b -> Unimo r a) -> v 


type Observer r a v = (a -> v) -> BindOp r a v -> Unimo r a -> v 

observe monad :: Observer r a v 
observe monad unit_op bind_op = eval where 
  eval (Unit v) = unit_op v 
  eval (Effect e) = e `bind_op` Unit 
  eval (Bind (Effect e) k) = e `bind_op` k 
  eval (Bind (Unit v) k) = eval (k v) 
  eval (Bind (Bind m k) g) = eval (Bind m cont) 
  where cont v = Bind (k v) g 


data StateE s (m :: * -> *) a where 
  Get :: StateE s m s 
  Put :: s -> StateE s m () 

type State s = Unimo (StateE s) 

run state :: forall a s. State s a -> s -> (a, s) 
run state m s = observe monad unit_op bind_op m where 
  unit_op v = (v, s) 
  bind_op :: BindOp (StateE s) a (a, s) 
  bind_op Get k = run state (k s) s 
  bind_op (Put s1) k = run state (k ()) s1 

-}
